home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / lockexpl.fr_ / lockexpl.fr
Text File  |  1995-07-06  |  13KB  |  455 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Lock Explorer"
  5.    ClientHeight    =   3960
  6.    ClientLeft      =   1590
  7.    ClientTop       =   1650
  8.    ClientWidth     =   3450
  9.    Height          =   4365
  10.    Left            =   1530
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   3960
  13.    ScaleWidth      =   3450
  14.    Top             =   1305
  15.    Width           =   3570
  16.    Begin VB.CommandButton cmdRefresh 
  17.       Caption         =   "&Refresh"
  18.       Default         =   -1  'True
  19.       BeginProperty Font 
  20.          name            =   "MS Sans Serif"
  21.          charset         =   0
  22.          weight          =   700
  23.          size            =   8.25
  24.          underline       =   0   'False
  25.          italic          =   0   'False
  26.          strikethrough   =   0   'False
  27.       EndProperty
  28.       Height          =   495
  29.       Left            =   300
  30.       TabIndex        =   11
  31.       Top             =   3180
  32.       Width           =   1215
  33.    End
  34.    Begin VB.CommandButton cmdLockPessimistic 
  35.       Caption         =   "&Pessimistic Locking"
  36.       BeginProperty Font 
  37.          name            =   "System"
  38.          charset         =   0
  39.          weight          =   700
  40.          size            =   9.75
  41.          underline       =   0   'False
  42.          italic          =   0   'False
  43.          strikethrough   =   0   'False
  44.       EndProperty
  45.       Height          =   375
  46.       Left            =   360
  47.       TabIndex        =   10
  48.       Top             =   2640
  49.       Width           =   2655
  50.    End
  51.    Begin VB.CommandButton cmdLockOptimistic 
  52.       Caption         =   "&Optimistic Locking"
  53.       BeginProperty Font 
  54.          name            =   "System"
  55.          charset         =   0
  56.          weight          =   700
  57.          size            =   9.75
  58.          underline       =   0   'False
  59.          italic          =   0   'False
  60.          strikethrough   =   0   'False
  61.       EndProperty
  62.       Height          =   375
  63.       Left            =   360
  64.       TabIndex        =   9
  65.       Top             =   2160
  66.       Width           =   2655
  67.    End
  68.    Begin VB.CommandButton cmdClose 
  69.       Cancel          =   -1  'True
  70.       Caption         =   "&Close"
  71.       BeginProperty Font 
  72.          name            =   "System"
  73.          charset         =   0
  74.          weight          =   700
  75.          size            =   9.75
  76.          underline       =   0   'False
  77.          italic          =   0   'False
  78.          strikethrough   =   0   'False
  79.       EndProperty
  80.       Height          =   495
  81.       Left            =   1860
  82.       TabIndex        =   8
  83.       Top             =   3180
  84.       Width           =   1215
  85.    End
  86.    Begin VB.CommandButton cmdNext 
  87.       Caption         =   ">"
  88.       BeginProperty Font 
  89.          name            =   "MS Sans Serif"
  90.          charset         =   0
  91.          weight          =   700
  92.          size            =   13.5
  93.          underline       =   0   'False
  94.          italic          =   0   'False
  95.          strikethrough   =   0   'False
  96.       EndProperty
  97.       Height          =   435
  98.       Left            =   2640
  99.       TabIndex        =   7
  100.       Top             =   1620
  101.       Width           =   435
  102.    End
  103.    Begin VB.TextBox txtPhone 
  104.       Height          =   285
  105.       Left            =   360
  106.       TabIndex        =   4
  107.       Top             =   1140
  108.       Width           =   1995
  109.    End
  110.    Begin VB.TextBox txtName 
  111.       Height          =   285
  112.       Left            =   360
  113.       TabIndex        =   3
  114.       Top             =   420
  115.       Width           =   2655
  116.    End
  117.    Begin VB.CommandButton cmdUpdate 
  118.       Caption         =   "&Update"
  119.       BeginProperty Font 
  120.          name            =   "System"
  121.          charset         =   0
  122.          weight          =   700
  123.          size            =   9.75
  124.          underline       =   0   'False
  125.          italic          =   0   'False
  126.          strikethrough   =   0   'False
  127.       EndProperty
  128.       Height          =   435
  129.       Left            =   1680
  130.       TabIndex        =   2
  131.       Top             =   1620
  132.       Width           =   975
  133.    End
  134.    Begin VB.CommandButton cmdEdit 
  135.       Caption         =   "&Edit"
  136.       BeginProperty Font 
  137.          name            =   "System"
  138.          charset         =   0
  139.          weight          =   700
  140.          size            =   9.75
  141.          underline       =   0   'False
  142.          italic          =   0   'False
  143.          strikethrough   =   0   'False
  144.       EndProperty
  145.       Height          =   435
  146.       Left            =   720
  147.       TabIndex        =   1
  148.       Top             =   1620
  149.       Width           =   975
  150.    End
  151.    Begin VB.CommandButton cmdPrevious 
  152.       Caption         =   "<"
  153.       BeginProperty Font 
  154.          name            =   "MS Sans Serif"
  155.          charset         =   0
  156.          weight          =   700
  157.          size            =   13.5
  158.          underline       =   0   'False
  159.          italic          =   0   'False
  160.          strikethrough   =   0   'False
  161.       EndProperty
  162.       Height          =   435
  163.       Left            =   300
  164.       TabIndex        =   0
  165.       Top             =   1620
  166.       Width           =   435
  167.    End
  168.    Begin VB.Label Label3 
  169.       AutoSize        =   -1  'True
  170.       BackColor       =   &H00C0C0C0&
  171.       Caption         =   "Telephone Number:"
  172.       BeginProperty Font 
  173.          name            =   "MS Sans Serif"
  174.          charset         =   0
  175.          weight          =   700
  176.          size            =   8.25
  177.          underline       =   0   'False
  178.          italic          =   0   'False
  179.          strikethrough   =   0   'False
  180.       EndProperty
  181.       Height          =   195
  182.       Left            =   360
  183.       TabIndex        =   6
  184.       Top             =   900
  185.       Width           =   1680
  186.    End
  187.    Begin VB.Label Label1 
  188.       AutoSize        =   -1  'True
  189.       BackColor       =   &H00C0C0C0&
  190.       Caption         =   "Publisher's Name:"
  191.       BeginProperty Font 
  192.          name            =   "MS Sans Serif"
  193.          charset         =   0
  194.          weight          =   700
  195.          size            =   8.25
  196.          underline       =   0   'False
  197.          italic          =   0   'False
  198.          strikethrough   =   0   'False
  199.       EndProperty
  200.       Height          =   195
  201.       Left            =   360
  202.       TabIndex        =   5
  203.       Top             =   180
  204.       Width           =   1530
  205.    End
  206. End
  207. Attribute VB_Name = "Form1"
  208. Attribute VB_Creatable = False
  209. Attribute VB_Exposed = False
  210. Option Explicit
  211.  
  212. ' Declare the recordset at the form level; several routines need to access
  213. ' the variable to work with the recordset.
  214.  
  215. Dim rs As Recordset
  216. Private Sub cmdClose_Click()
  217.     End
  218. End Sub
  219. Private Sub cmdEdit_Click()
  220.  
  221.     ' Set up error handling.
  222.  
  223.     On Error GoTo EditError
  224.  
  225.     ' Fill the copy buffer with the contents of the current record.
  226.     ' In real code, you would not execute an error and leave it "hanging"
  227.     ' like this when you exit from the procedure. This is for demnonstration
  228.     ' purposes only.
  229.  
  230.     rs.Edit
  231.  
  232. Exit Sub
  233.  
  234. EditError:
  235.  
  236.     Dim msg As String
  237.  
  238.     ' If a predictable locking error message is received, display an error
  239.     ' message explaining what's going on. Otherwise, just pass through
  240.     ' Visual Basic's error message.
  241.  
  242.      Select Case Err
  243.         Case 3167
  244.             msg = "Some dirty rat has deleted the record you are tring to modify!"
  245.         Case 3260
  246.             msg = "Locking error " & Str$(Err) & " on Edit."
  247.             msg = msg & " Pessimistic locking must be enabled!"
  248.         Case Else
  249.             msg = Error(Err)
  250.     End Select
  251.  
  252.  
  253.     MsgBox msg, vbExclamation
  254. Exit Sub
  255.  
  256. End Sub
  257. Private Sub cmdLockOptimistic_Click()
  258.  
  259.     ' Set optimistic locking by calling the SetLockEdit procedure.
  260.  
  261.     SetLockEdit False
  262.  
  263. End Sub
  264. Private Sub cmdLockPessimistic_Click()
  265.  
  266.     ' Set pessimistic locking by calling the SetLockEdit procedure.
  267.  
  268.     SetLockEdit True
  269.  
  270. End Sub
  271. Private Sub cmdPrevious_Click()
  272.  
  273.     ' Position the record pointer on the previous record in the dynaset.
  274.  
  275.     rs.MovePrevious
  276.  
  277.     If rs.BOF Then
  278.  
  279.         ' If that positioned the pointer to BOF (before the first record),
  280.         ' alert the user with a beep and reposition back to the first record.
  281.  
  282.         rs.MoveNext
  283.         Beep
  284.  
  285.     Else
  286.  
  287.         ' Display the new record's values in the text boxes.
  288.  
  289.         DisplayRecord
  290.  
  291.     End If
  292.  
  293. End Sub
  294. Private Sub cmdNext_Click()
  295.  
  296.     ' Position the record pointer to the previous record in the dynaset.
  297.  
  298.     rs.MoveNext
  299.  
  300.     If rs.EOF Then
  301.  
  302.         ' If that positioned the pointer to EOF (afterthe last record),
  303.         ' alert the user with a beep and reposition back to the last record.
  304.  
  305.         rs.MovePrevious
  306.         Beep
  307.  
  308.     Else
  309.  
  310.         ' Display the new record's values in the text boxes.
  311.  
  312.         DisplayRecord
  313.  
  314.     End If
  315.  
  316. End Sub
  317.  
  318. Private Sub cmdRefresh_Click()
  319.  
  320.     ' Get the current values for the current page of the dynaset from the
  321.     ' database and display them.
  322.  
  323.     rs.Requery
  324.     DisplayRecord
  325.  
  326. End Sub
  327. Private Sub cmdUpdate_Click()
  328.  
  329.     ' Set up error handling.
  330.  
  331.     On Error GoTo UpdateError
  332.  
  333.     ' Place the current values of the text boxes into the copy buffer.
  334.  
  335.     rs!Name = txtName
  336.     rs!Telephone = txtPhone
  337.  
  338.     ' Write the contents of the copy buffer to the current record.
  339.  
  340.     rs.UPDATE
  341.  
  342. Exit Sub
  343.  
  344. UpdateError:
  345.     Dim msg As String
  346.  
  347.     Select Case Err
  348.  
  349.         Case 3197
  350.  
  351.             ' Another user has updated this record since the last time the
  352.             ' Dynaset was updated. Display a meaningful error message and give
  353.             ' the user the chance to overwrite the other user's change.
  354.  
  355.             msg = "The data in this record have already been modified by"
  356.             msg = msg & " another user. Do you want to overwrite those chenges"
  357.             msg = msg & " with your own?"
  358.  
  359.             If MsgBox(msg, vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
  360.  
  361.                 ' The user said yes, so re-execute the Update method. This time
  362.                 ' it should "take."
  363.  
  364.                 Resume
  365.  
  366.             Else
  367.  
  368.                 ' The user said no, so refresh the dynaset with the current
  369.                 ' data and display that data. Then display a message explaining
  370.                 ' what's happened.
  371.  
  372.                 rs.Requery
  373.                 DisplayRecord
  374.                 msg = "The current values of the record are now displayed."
  375.                 MsgBox msg, vbInformation
  376.  
  377.                 ' Exit from the procedure now to bypass the code after the
  378.                 ' End Select statement.
  379.  
  380.                 Exit Sub
  381.  
  382.             End If
  383.  
  384.         Case 3020
  385.  
  386.             ' The user clicked Update without previously having clicked
  387.             ' Edit. The default error message is "Update without AddNew
  388.             ' or Edit." Create an error that is more meaningful in the current
  389.             ' context. (The message gets displayed after the End Select
  390.             ' statement).
  391.  
  392.             msg = "You must click Edit before you click Update!"
  393.  
  394.         Case 3260
  395.  
  396.             ' Another user has the page locked. Create a meaningful message.
  397.             ' (The message gets displayed after the End Select statement.)
  398.  
  399.             msg = "Locking error " & Str$(Err) & " on Update."
  400.             msg = msg & " Optimistic locking must be enabled!"
  401.  
  402.         Case Else
  403.  
  404.             ' An unanticipated error, so just pass through Visual Basic's
  405.             ' message.
  406.  
  407.             msg = Error(Err)
  408.  
  409.     End Select
  410.  
  411.     MsgBox msg, vbExclamation
  412.  
  413. Exit Sub
  414.  
  415. End Sub
  416. Private Sub Form_Load()
  417.     Dim db As DATABASE
  418.     Dim dbName As String
  419.     Dim sql As String
  420.  
  421.     ' Get the database name and open the database.
  422.     dbName = BiblioPath()       ' BiblioPath is a function in READINI.BAS
  423.     Set db = DBEngine.Workspaces(0).OpenDatabase(dbName)
  424.  
  425.     ' Create a dynaset-type recordset assigned to the module-level Recordset
  426.     ' variable rs. By default, LockEdits is True when you create a new dynaset
  427.     ' and therefore, pessimistic locking is enabled.
  428.  
  429.     sql = "SELECT [Name], [Telephone] from [Publishers] ORDER BY [Name]"
  430.     Set rs = db.OpenRecordset(sql, dbOpenDynaset)
  431.  
  432.     ' Display the first record in the dynaset
  433.  
  434.     DisplayRecord
  435.  
  436. End Sub
  437.  
  438. Sub SetLockEdit(lockOnEdit As Boolean)
  439.  
  440.     ' Set the LockEdits property as specified by the argument.
  441.  
  442.     rs.LockEdits = lockOnEdit
  443. End Sub
  444.  
  445. '*******************************************************************************
  446. Private Sub DisplayRecord()
  447.  
  448.     ' Fill the text boxes on the form, converting any Nulls in the database
  449.     ' to zero-length strings.
  450.  
  451.     If Not IsNull(rs!Name) Then txtName = rs!Name Else txtName = ""
  452.     If Not IsNull(rs!Telephone) Then txtPhone = rs!Telephone Else txtPhone = ""
  453.  
  454. End Sub
  455.